Prevod castky na slova
Otázka od: Pavel Zichovsky
26. 9. 2002 17:18
Dobrý den,
nemate nekdo prosim funkci pro prevod cisla na text
slovy (napr. cislo 583 na text "petsetosmdesattri")?
Potrebuju to do jednoho programu pro vnitrni
potrebu, a nechce se mi to vymyslet, pokud uz to
nekdo ma, a bude ochoten mi to (zdarma)
poskytnout.
Delphi 6 Pro
Predem moc diky.
S pozdravem
Pavel Žichovský (zichovsky@trul.cz)
Odpovedá: Ing. Pavel Žilinec
26. 9. 2002 17:21
Kdysi to tu bylo, tak jsme si to vzali a mozna to i trochu upravili,
tak tady to je - jen to mame jeste lokalizovane (je to na konci).
Mozna tam budou nejake vlastni fce, ale to uz asi nebude problem
nahradit. Navic jsem z duvodu pravidel odstranil diakritiku, tak si ji
zase dopln.
function CurrToText(Value : Currency) : string;
function Stovky(Trojice : string) : string;
var Prvni, Druha, Treti : string;
Pom1, Pom2, Pom3 : Integer;
begin
Result := '';
Prvni := '0';
Druha := '0';
Treti := '0';
case Length(Trojice) of
3 : begin
Prvni := copy(Trojice,1,1);
Druha := copy(Trojice,2,1);
Treti := copy(Trojice,3,1);
end;
2 : begin
Druha := copy(Trojice,1,1);
Treti := copy(Trojice,2,1);
end;
1 : Treti := Trojice;
end;
if Prvni[1] in ['0','P'] then Pom1 := 0
else Pom1 := StrToInt(Prvni);
if Druha[1] in ['0','P'] then Pom2 := 0
else Pom2 := StrToInt(Druha);
if Treti[3] in ['0','P'] then Pom3 := 0
else Pom3 := StrToInt(Treti);
case Pom1 of
1..2 : Result := Result + GetStr(3280 + Pom1);
3..4 : Result := Result + GetStr(3250 + Pom1) + GetStr(3283);
5..9 : Result := Result + GetStr(3250 + Pom1) + GetStr(3284);
end;
case Pom2 of
1 : Result := Result + GetStr(3260 + Pom3)
else Result := Result + GetStr(3270 + Pom2)
end;
if (Pom2 <> 1) and (Pom3 in [1..9]) then Result := Result + GetStr(3250 +
Pom3);
end;
var Pom : integer;
CisloChr, Prvni, Druha, Treti, Ctvrta : string;
begin
Pom := 0;
Result := '';
STR(ABS(Trunc(Value)), CisloChr);
CisloChr := TrimLeft(CisloChr);
case Length(CisloChr) of
10..12 : begin
Prvni := Copy(CisloChr, 1, Length(CisloChr)-9);
Druha := Copy(CisloChr, Length(Prvni)+1, 3);
Treti := Copy(CisloChr, Length(Prvni)+4, 3);
Ctvrta := Copy(CisloChr, Length(Prvni)+7, 3);
end;
7..9 : begin
Prvni := '';
Druha := Copy(CisloChr, 1, Length(CisloChr)-6);
Treti := Copy(CisloChr, Length(Druha)+1, 3);
Ctvrta := Copy(CisloChr, Length(Druha)+4, 3);
end;
4..6 : begin
Prvni := '';
Druha := '';
Treti := Copy(CisloChr, 1, Length(CisloChr)-3);
Ctvrta := Copy(CisloChr, Length(Treti)+1, 3);
end;
1..3 : begin
Prvni := '';
Druha := '';
Treti := '';
Ctvrta := CisloChr;
end;
else begin
Prvni := '';
Druha := '';
Treti := '';
Ctvrta := '0';
end;
end;
{Konverze miliard}
if Length(Prvni) > 0 then
if StrToInt(Prvni) < 3 then Result := GetStr(3289 + Pom)
else Result := GetStr(3292);
{Konverze milionu}
if Length(Druha) > 0 then
if StrToInt(Druha) = 1 then Result := Result + GetStr(3287)
else if StrToInt(Druha) < 5 then Result := Result + Stovky(Druha) +
GetStr(3288)
else Result := Result + Stovky(Druha) + GetStr(3289);
{Konverze tisicu}
if Length(Treti) > 0 then
case StrToInt(Treti) of
0 : Result := Result;
1 : Result := Result +GetStr(3285);
2..4 : Result := Result + Stovky(Treti) + GetStr(3286);
else Result := Result + Stovky(Treti) + GetStr(3285);
end;
{Konverze do nuly}
if Length(Ctvrta) > 0 then Result := Result + Stovky(Ctvrta);
if Length(Result) = 0 then Result := GetStr(3250);
{Znamenko}
if Value < 0 then Result := GetStr(3299) + Result;
{Desetinna cast - jako zlomek (minimalne setiny)}
Pom := ABS(Trunc((Value - Trunc(Value)) * 10000));
if Pom <> 0 then
begin
{Pokud to pujde, necham to misto na 4 jen 2 desetinna mista}
if Pom mod 10 = 0 then Pom := Pom div 10;
if Pom mod 10 = 0 then Pom := Pom div 10;
{A doplnim i ten zlomek}
Result := Result + ' ' + IntToStr(Pom) + '/1' + MakeStr('0',
Length(IntToStr(Pom)));
end;
end;
STRINGTABLE
{
3250, "nula"
3251, "jedna"
3252, "dve"
3253, "tri"
3254, "ctyri"
3255, "pet"
3256, "sest"
3257, "sedm"
3258, "osm"
3259, "devet"
3260, "deset"
3261, "jedenact"
3262, "dvanact"
3263, "trinact"
3264, "ctrnact"
3265, "patnact"
3266, "sestnact"
3267, "sedmnact"
3268, "osmnact"
3269, "devatenact"
3272, "dvacet"
3273, "tricet"
3274, "ctyricet"
3275, "padesat"
3276, "sedesat"
3277, "sedmdesast"
3278, "osmdesat"
3279, "devadesat"
3281, "sto"
3282, "dveste"
3283, "sta"
3284, "set"
3285, "tisic"
3286, "tisice"
3287, "milion"
3288, "miliony"
3289, "milionu"
3290, "miliarda"
3291, "miliardy"
3292, "miliard"
3299, "minus "
}
--------
ing. Pavel Zilinec
MailTo:zilinec@email.cz
Prog-Soft s.r.o. Plzen
Informacni system pro vyrobce
a distributory napoju
PZ> Dobrý den,
PZ> nemate nekdo prosim funkci pro prevod cisla na text
PZ> slovy (napr. cislo 583 na text "petsetosmdesattri")?
PZ> Potrebuju to do jednoho programu pro vnitrni
PZ> potrebu, a nechce se mi to vymyslet, pokud uz to
PZ> nekdo ma, a bude ochoten mi to (zdarma)
PZ> poskytnout.
PZ> Delphi 6 Pro
PZ> Predem moc diky.
PZ> S pozdravem
PZ> Pavel Žichovský (zichovsky@trul.cz)